home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GCONVERT.IMP < prev    next >
Text File  |  1992-09-01  |  41KB  |  1,184 lines
  1.    {*******************************************************************
  2.  
  3.    GCONVERT.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.    BOOLEAN
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    0/1 ==> "True "/"False"
  14.  
  15.    ===================================================================}
  16. function BooleanTrueFalse    ( B : boolean ) : string ;
  17. begin
  18.    if B then
  19.       BooleanTrueFalse       := 'True '
  20.    else
  21.       BooleanTrueFalse       := 'False' ;
  22. end ;
  23.    {===================================================================
  24.  
  25.    0/1 ==> "Yes"/"No "
  26.  
  27.    ===================================================================}
  28. function BooleanYesNo        ( B : boolean ) : string ;
  29. begin
  30.    if B then
  31.       BooleanYesNo           := 'Yes'
  32.    else
  33.       BooleanYesNo           := 'No ' ;
  34. end ;
  35.    {===================================================================
  36.  
  37.    0/1 ==> "On "/"Off"
  38.  
  39.    ===================================================================}
  40. function BooleanOnOff        ( B : boolean ) : string ;
  41. begin
  42.    if B then
  43.       BooleanOnOff           := 'On '
  44.    else
  45.       BooleanOnOff           := 'Off' ;
  46. end ;
  47.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  48.  
  49.    NUMBER <-> STRING
  50.  
  51.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  52.    {===================================================================
  53.  
  54.    REAL   "999.9" --> 999.9
  55.  
  56.    ===================================================================}
  57. function StrToReal ( S : string ) : real ;
  58. var
  59.    R                         : real ;
  60.    code                      : integer ;
  61. begin
  62.    StrToReal                 := 0 ;
  63.    Val ( S , R , code ) ;
  64.    if code = 0 then
  65.       StrToReal              := R ;
  66. end ;
  67.    {===================================================================
  68.  
  69.    RANGE - need this cause "Val" isn't too bright
  70.  
  71.    ===================================================================}
  72. function Range ( S : string ; Low , High : real ) : boolean ;
  73. var
  74.    R                         : real ;
  75. begin
  76.    R                         := StrToReal ( S ) ;
  77.    Range                     := ( R >= Low ) and
  78.                                 ( R <= High ) ;
  79. end ;
  80.    {===================================================================
  81.  
  82.    BYTE   "999" -> 999
  83.  
  84.    ===================================================================}
  85. function StrToByte ( S : string ) : byte ;
  86. var
  87.    b                         : byte ;
  88.    code                      : integer ;
  89. begin
  90.    StrToByte                 := 0 ;
  91.    if not Range ( S , 0 , 255 ) then EXIT ;
  92.    Val ( S , b , code ) ;
  93.    StrToByte                 := b ;
  94. end ;
  95.    {===================================================================
  96.  
  97.    INTEGER   "999" --> 999
  98.  
  99.    ===================================================================}
  100. function StrToShort ( S : string ) : shortint ;
  101. var
  102.    i                         : shortint ;
  103.    code                      : integer ;
  104. begin
  105.    StrToShort                := 0 ;
  106.    Val ( S , i , code ) ;
  107.    if not Range ( S , -128 , 127 ) then EXIT ;
  108.    StrToShort                := i ;
  109. end ;
  110.    {===================================================================
  111.  
  112.    INTEGER   "999" --> 999
  113.  
  114.    ===================================================================}
  115. function StrToInt ( S : string ) : integer ;
  116. var
  117.    i                         : integer ;
  118.    code                      : integer ;
  119. begin
  120.    StrToInt                  := 0 ;
  121.    Val ( S , i , code ) ;
  122.    if not Range ( S , -32768 , 32767 ) then EXIT ;
  123.    StrToInt                  := i ;
  124. end ;
  125.    {===================================================================
  126.  
  127.    WORD   "999" --> 999
  128.  
  129.    ===================================================================}
  130. function StrToWord ( S : string ) : word ;
  131. var
  132.    W                         : word ;
  133.    code                      : integer ;
  134. begin
  135.    StrToWord                 := 0 ;
  136.    Val ( S , W , code ) ;
  137.    if not Range ( S , 0 , 65535 ) then EXIT ;
  138.    StrToWord                 := W ;
  139. end ;
  140.    {===================================================================
  141.  
  142.    LONG   "999" --> 999
  143.  
  144.    ===================================================================}
  145. function StrToLong ( S : string ) : longint ;
  146. var
  147.    L                         : longint ;
  148.    code                      : integer ;
  149. begin
  150.    StrToLong                 := 0 ;
  151.    Val ( S , L , code ) ;
  152.    if not Range ( S , -2147483647 , 2147483647 ) then EXIT ;
  153.    StrToLong                 := L ;
  154. end ;
  155.    {===================================================================
  156.  
  157.    Byte,Shortint,Integer,Longint,Real --> String
  158.  
  159.    ===================================================================}
  160. function NumToStr ( R : real ) : string ;
  161. var
  162.    S1 ,
  163.    S2                        : string ;
  164.    L                         : longint ;
  165. begin
  166.    L                         := Trunc ( R ) ;          { 1.23 -->   1 }
  167.    R                         := Frac ( R ) ;           { 1.23 --> .23 }
  168.    Str ( L : -1 , S1 ) ;
  169.    Str ( R : -1 : 5 , S2 ) ;
  170.    SYSTEM.delete ( S2 , 1 , 1 ) ;
  171.    S1                        := S1 + S2 ;
  172.    while S1 [ length ( S1 ) ] = '0' do
  173.       SYSTEM.delete ( S1 , length ( S1 ) , 1 ) ;
  174.    while S1 [ length ( S1 ) ] = '.' do
  175.       SYSTEM.delete ( S1 , length ( S1 ) , 1 ) ;
  176.    if S1 = '' then
  177.       S1                     := '0' ;
  178.    NumToStr                  := S1 ;
  179. end ;
  180.    {===================================================================
  181.  
  182.    DOS - When 100's or Day of week can be ignored.
  183.  
  184.    ===================================================================}
  185. procedure GetDateTime ( VAR DT : DateTime ) ;
  186. var
  187.    Sec100 ,
  188.    DoW                       : word ;
  189. begin
  190.    GetDate ( DT.Year , DT.Month , DT.Day , DoW ) ;
  191.    GetTime ( DT.Hour , DT.Min , DT.Sec , Sec100 ) ;
  192. end ;
  193.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  194.  
  195.    VALIDITY CHECKS
  196.  
  197.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  198.    {===================================================================
  199.  
  200.    LEAP YEAR - forces century if year less than 100
  201.  
  202.    ===================================================================}
  203. function IsLeapYear ( Y : longint ) : boolean ;
  204. var
  205.    DT                        : DateTime ;
  206. begin
  207.    GetDateTime ( DT ) ;
  208.    if Y < 100 then
  209.       inc ( Y , ( DT.Year div 100 ) * 100 ) ;
  210.    IsLeapYear                  := Y mod 4 = 0 ;
  211. end ;
  212.    {===================================================================
  213.  
  214.    YEAR - greater than 0
  215.  
  216.    ===================================================================}
  217. function IsYearValid ( Y : word ) : boolean ;
  218. begin
  219.    IsYearValid                 := Y > 0 ;
  220. end ;
  221.    {===================================================================
  222.  
  223.    MONTH - 1 and 12
  224.  
  225.    ===================================================================}
  226. function IsMonthValid ( M : word ) : boolean ;
  227. begin
  228.    IsMonthValid                := ( M >= 1 ) and ( M <= 12 ) ;
  229. end ;
  230.    {===================================================================
  231.  
  232.    DAY - as per month
  233.  
  234.    ===================================================================}
  235. function MaxDayForMonth ( M , Y : word ) : word ;
  236. begin
  237.    case M of
  238.    2 :
  239.       if IsLeapYear ( Y ) then
  240.          MaxDayForMonth      := 29
  241.       else
  242.          MaxDayForMonth      := 28 ;
  243.    4 ,
  244.    6,
  245.    9,
  246.    11 : MaxDayForMonth := 30 ;
  247.    else
  248.       MaxDayForMonth := 31 ;
  249.    end ;
  250. end ;
  251.    {===================================================================
  252.  
  253.    DAY - Valid for month
  254.  
  255.    ===================================================================}
  256. function IsDayValid ( M , D , Y : word ) : boolean ;
  257. begin
  258.    IsDayValid                := ( D >= 1 ) and
  259.                                 ( D <=